home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue36 / construc / DRBOBUUE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-06-30  |  13.1 KB  |  424 lines
  1. unit DrBobUUE;
  2. interface
  3. uses
  4.   Windows, SysUtils, Classes;
  5.  
  6. type
  7.   EUUCode = class(Exception);
  8.  
  9.   TAlgorithm = (filecopy, uuencode, uudecode, xxencode, xxdecode, base64encode, base64decode);
  10.   TUnixCRLF = (CRLF, LF);
  11.  
  12.   TProgressEvent = procedure(Percent: Word) of Object;
  13.  
  14.   TBUUCode = class(TComponent)
  15.   public
  16.   { Public class declarations (override) }
  17.     constructor Create(AOwner: TComponent); override;
  18.  
  19.   private
  20.   { Private field declarations }
  21.     FAbout: ShortString;
  22.     FActive: Boolean;
  23.     FAlgorithm: TAlgorithm;
  24.     FFileMode: Word;
  25.     FHeaders: Boolean;
  26.     FInputFileName: TFileName;
  27.     FOutputFileName: TFileName;
  28.     FOnProgress: TProgressEvent;
  29.     FUnixCRLF: TUnixCRLF;
  30.   { Dummy method to get read-only About property }
  31.     procedure Dummy(Ignore: ShortString);
  32.  
  33.   protected
  34.   { Protected Activate method }
  35.     procedure Activate(GoActive: Boolean);
  36.  
  37.   public
  38.   { Public UUCode interface declaration }
  39.     procedure UUCode;
  40.  
  41.   published
  42.   { Published design declarations }
  43.     property About: ShortString read FAbout write Dummy;
  44.     property Active: Boolean read FActive write Activate;
  45.     property Algorithm: TAlgorithm read FAlgorithm write FAlgorithm;
  46.     property FileMode: Word read FFileMode write FFileMode;
  47.     property Headers: Boolean read FHeaders write FHeaders;
  48.     property InputFile: TFileName read FInputFileName write FInputFileName;
  49.     property OutputFile: TFileName read FOutputFileName write FOutputFileName;
  50.     property UnixCRLF: TUnixCRLF read FUnixCRLF write FUnixCRLF;
  51.  
  52.   published
  53.   { Published Event property }
  54.     property OnProgress: TProgressEvent read FOnProgress write FOnProgress;
  55.   end {TBUUCode};
  56.  
  57.  
  58. implementation
  59.  
  60.   constructor TBUUCode.Create(AOwner: TComponent);
  61.   begin
  62.     inherited Create(AOwner);
  63.     FActive := False;
  64.     FFileMode := 0644;
  65.     FHeaders := True;
  66.     FAbout := 'TBUUCode 4.0 (c) 1998 by Bob Swart (aka Dr.Bob - www.drbob42.com)'
  67.   end {Create};
  68.  
  69.   procedure TBUUCode.Dummy(Ignore: ShortString);
  70.   begin
  71.   end {Dummy};
  72.  
  73.   procedure TBUUCode.Activate(GoActive: Boolean);
  74.   begin
  75.     if GoActive and not FActive then
  76.     begin
  77.       FActive := True;
  78.     { Application.ProcessMessages; { Update Object Inspector }
  79.       UUCode;
  80.       FActive := False
  81.     end
  82.   end {Activate};
  83.  
  84.  
  85.   procedure TBUUCode.UUCode;
  86.   const
  87.     SP = #32;
  88.     CR = #13;
  89.     LF = #10;
  90.     EOF= #27;
  91.   const
  92.     header: Array[Boolean] of ShortString =
  93.       ('begin %.4d %s', { + filename }
  94.        'begin-base64 %.4d %s'); { + filename }
  95.     footer: ShortString = 'end';
  96.   const
  97.     UU: Array[0..63] of Char = '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
  98.     XX: Array[0..63] of Char =  '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
  99.     B64: Array[0..63] of Char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  100.   const
  101.     EUUOutputEmpty = 'OutputFileName is empty';
  102.     EUUInputEmpty = 'InputFileName is empty';
  103.     EUUFileTooBig = 'InputFile is too big';
  104.   type
  105.     TTriplet = Array[0..2] of Byte;
  106.     TKwartet = Array[0..3] of Byte;
  107.   var
  108.     InputBuffer,OutputBuffer: Pointer;
  109.     InputBufSize,OutputBufSize: LongInt;
  110.     Size: Cardinal;
  111.     HeadStr: ShortString;
  112.     f: File;
  113.  
  114.     function FileSize(FileName: ShortString): LongInt;
  115.     var
  116.       SRec: TSearchRec;
  117.     begin
  118.       if FindFirst(FileName,faArchive,SRec) = 0 then
  119.         FileSize := SRec.Size
  120.       else FileSize := 0;
  121.       FindClose(SRec)
  122.     end {FileSize};
  123.  
  124.  
  125.     procedure Encode(Base64, XXCode: Boolean);
  126.     const
  127.       TripletBlock: Array[Boolean] of Word = (15,19);
  128.     var
  129.       I,O: ^Char;
  130.       j,k: LongInt;
  131.       Triplet: ^TTriplet;
  132.       Kwartet: ^TKwartet;
  133.  
  134.       procedure PutChar(Ch: Char);
  135.       begin
  136.         O^ := Ch;
  137.         Inc(O);
  138.         Inc(Size)
  139.       end {PutChar};
  140.  
  141.       procedure Triplet2Kwartet(Const Triplet: TTriplet; var Kwartet: TKwartet);
  142.       var
  143.         i: Integer;
  144.       begin
  145.         Kwartet[0] := (Triplet[0] SHR 2);
  146.         Kwartet[1] := ((Triplet[0] SHL 4) AND $30) +
  147.                       ((Triplet[1] SHR 4) AND $0F);
  148.         Kwartet[2] := ((Triplet[1] SHL 2) AND $3C) +
  149.                       ((Triplet[2] SHR 6) AND $03);
  150.         Kwartet[3] := (Triplet[2] AND $3F);
  151.         for i:=0 to 3 do
  152.           if Kwartet[i] = 0 then
  153.             Kwartet[i] := $40 + Ord(SP)
  154.           else Inc(Kwartet[i],Ord(SP));
  155.         if Base64 then
  156.           for i:=0 to 3 do
  157.             Kwartet[i] := Ord(B64[(Kwartet[i] - Ord(SP)) mod $40])
  158.         else
  159.           if XXCode then
  160.             for i:=0 to 3 do
  161.               Kwartet[i] := Ord(XX[(Kwartet[i] - Ord(SP)) mod $40])
  162.       end {Triplet2Kwartet};
  163.  
  164.     begin
  165.       Size := 0;
  166.       I := InputBuffer;
  167.       O := OutputBuffer;
  168.       if Assigned(FOnProgress) then
  169.         FOnProgress(trunc((100.0 * Size) / OutputBufSize));
  170.       if FHeaders then
  171.       begin
  172.         HeadStr := Format(header[Base64],
  173.                          [FFileMode,ExtractFileName(FInputFileName)]);
  174.         for j:=1 to Length(HeadStr) do PutChar(HeadStr[j]);
  175.         if (FUnixCRLF = CRLF) then PutChar(CR);
  176.         PutChar(LF);
  177.       end;
  178.       j := InputBufSize;
  179.       while j >= (TripletBlock[Base64] * SizeOf(TTriplet)) do
  180.       begin
  181.         if not Base64 then
  182.           if XXCode then
  183.             PutChar(XX[TripletBlock[Base64] * SizeOf(TTriplet)])
  184.           else { uucode }
  185.             PutChar(UU[TripletBlock[Base64] * SizeOf(TTriplet)]);
  186.         for k:=1 to TripletBlock[Base64] do
  187.         begin
  188.           Triplet := Addr(I^);
  189.           Inc(I,SizeOf(TTriplet));
  190.           Kwartet := Addr(O^);
  191.           Inc(O,SizeOf(TKWartet));
  192.           Triplet2Kwartet(Triplet^,Kwartet^);
  193.           Inc(Size,SizeOf(TKwartet));
  194.           Dec(j,SizeOf(TTriplet))
  195.         end;
  196.         if Assigned(FOnProgress) then
  197.           FOnProgress(trunc((100.0 * Size) / OutputBufSize));
  198.         if (FUnixCRLF = CRLF) then PutChar(CR);
  199.         PutChar(LF)
  200.       end;
  201.       if not Base64 then
  202.         if XXCode then
  203.           PutChar(XX[j])
  204.         else { uucode }
  205.           PutChar(UU[j]);
  206.       while j > 0 {SizeOf(TTriplet)} do
  207.       begin
  208.         Triplet := Addr(I^);
  209.         Inc(I,SizeOf(TTriplet));
  210.         Kwartet := Addr(O^);
  211.         Inc(O,SizeOf(TKWartet));
  212.         Triplet2Kwartet(Triplet^,Kwartet^);
  213.         Inc(Size,SizeOf(TKwartet));
  214.         Dec(j,SizeOf(TTriplet));
  215.         if j < 0 then
  216.         begin
  217.           Inc(Size,j); { skip last null characters }
  218.           Inc(O,j)
  219.         end
  220.       end;
  221.       if (FUnixCRLF = CRLF) then PutChar(CR);
  222.       PutChar(LF);
  223.       if FHeaders then
  224.         for j:=1 to Length(footer) do PutChar(footer[j]);
  225.       if (FUnixCRLF = CRLF) then PutChar(CR);
  226.       PutChar(LF);
  227.       if Assigned(FOnProgress) then
  228.         FOnProgress(trunc((100.0 * Size) / OutputBufSize))
  229.     end {Encode};
  230.  
  231.  
  232.     procedure Decode(Base64, XXCode: Boolean);
  233.     const
  234.       headend: Array[Boolean] of LongInt = (6, 13);
  235.     var
  236.       j,k: LongInt;
  237.       I,O,E: ^Char;
  238.       Kwartet: TKwartet;
  239.       Triplet: ^TTriplet;
  240.  
  241.       procedure PutChar(Ch: Char);
  242.       begin
  243.         O^ := Ch;
  244.         Inc(O);
  245.         Inc(Size)
  246.       end {PutChar};
  247.  
  248.       procedure Kwartet2Triplet(Kwartet: TKwartet; var Triplet: TTriplet);
  249.       var
  250.         i: Integer;
  251.       begin
  252.         if Base64 then
  253.         begin
  254.           for i:=0 to 3 do
  255.           begin
  256.             case Chr(Kwartet[i]) of
  257.              'A'..'Z': Kwartet[i] := 0 + Kwartet[i] - Ord('A') + Ord(SP);
  258.              'a'..'z': Kwartet[i] := 26+ Kwartet[i] - Ord('a') + Ord(SP);
  259.              '0'..'9': Kwartet[i] := 52+ Kwartet[i] - Ord('0') + Ord(SP);
  260.                   '+': Kwartet[i] := 62+ Ord(SP);
  261.                   '/': Kwartet[i] := 63+ Ord(SP)
  262.             end
  263.           end
  264.         end
  265.         else
  266.         if XXCode then
  267.         begin
  268.           for i:=0 to 3 do
  269.           begin
  270.             case Chr(Kwartet[i]) of
  271.                   '+': Kwartet[i] := 0 + Ord(SP);
  272.                   '-': Kwartet[i] := 1 + Ord(SP);
  273.              '0'..'9': Kwartet[i] := 2 + Kwartet[i] - Ord('0') + Ord(SP);
  274.              'A'..'Z': Kwartet[i] := 12 + Kwartet[i] - Ord('A') + Ord(SP);
  275.              'a'..'z': Kwartet[i] := 38 + Kwartet[i] - Ord('a') + Ord(SP)
  276.             end
  277.           end
  278.         end;
  279.         Triplet[0] :=  ((Kwartet[0] - Ord(SP)) SHL 2) +
  280.                       (((Kwartet[1] - Ord(SP)) AND $30) SHR 4);
  281.         Triplet[1] := (((Kwartet[1] - Ord(SP)) AND $0F) SHL 4) +
  282.                       (((Kwartet[2] - Ord(SP)) AND $3C) SHR 2);
  283.         Triplet[2] := (((Kwartet[2] - Ord(SP)) AND $03) SHL 6) +
  284.                        ((Kwartet[3] - Ord(SP)) AND $3F)
  285.       end {Kwartet2Triplet};
  286.  
  287.     begin
  288.       Size := 0;
  289.       I := InputBuffer;
  290.       O := OutputBuffer;
  291.       if Assigned(FOnProgress) then
  292.         FOnProgress(trunc((100.0 * Size) / OutputBufSize));
  293.       j := 1;
  294.       k := 0;
  295.       if FHeaders then
  296.       begin
  297.         repeat
  298.           if (I^ = header[Base64,j]) then
  299.             Inc(j)
  300.           else j := 1;
  301.           Inc(k);
  302.           Inc(I)
  303.         until (j = headend[Base64]) or (k >= InputBufSize);
  304.         repeat
  305.           Inc(I);
  306.           Inc(k);
  307.         until (I^ = ' ') or (k >= InputBufSize);
  308.         FOutputFileName := ExtractFilePath(FInputFileName);
  309.         if Length(FOutputFileName) > 0 then
  310.           if FOutputFileName[Length(FOutputFileName)] <> '\' then
  311.             FOutputFileName := FOutputFileName + '\';
  312.         repeat
  313.           Inc(I);
  314.           Inc(k);
  315.           if not (I^ in ['"',CR,LF]) then
  316.             FOutputFileName := FOutputFileName + I^
  317.         until (I^ = LF) or (k >= InputBufSize); { first line }
  318.         while (I^ in [CR,LF]) and (k < InputBufSize) do
  319.         begin
  320.           Inc(I);
  321.           Inc(k) { pass the end-of-line(s) }
  322.         end;
  323.       end;
  324.       if FOutputFileName = '' then
  325.         raise EUUCode.Create(EUUOutputEmpty)
  326.       else
  327.       repeat
  328.         E := I;
  329.         j := 1;
  330.         while (E^ = footer[j]) and (j <= Length(footer))
  331.                                and (k+j <= InputBufSize) do
  332.         begin
  333.           Inc(j);
  334.           Inc(E)
  335.         end;
  336.         if j > Length(footer) then k := InputBufSize { exit }
  337.         else
  338.         begin
  339.           if Assigned(FOnProgress) then
  340.             FOnProgress(trunc((100.0 * Size) / OutputBufSize));
  341.           if not Base64 then { skip first character of each line }
  342.           begin
  343.             Inc(I);
  344.             Inc(k)
  345.           end;
  346.           if not (I^ in [CR,LF]) then
  347.           repeat
  348.             E := I;
  349.             j := 0;
  350.             FillChar(Kwartet,SizeOf(TKwartet),#0);
  351.             repeat
  352.               Kwartet[j] := Ord(E^);
  353.               Inc(j);
  354.               Inc(E)
  355.             until (j = SizeOf(TKwartet)) or (E^ in [CR,LF]);
  356.             Inc(I,j);
  357.             Triplet := Addr(O^);
  358.             Inc(O,SizeOf(TTriplet));
  359.             Kwartet2Triplet(Kwartet,Triplet^);
  360.             Inc(Size,SizeOf(TTriplet)+j-SizeOf(TKwartet));
  361.             Inc(k,SizeOf(TKwartet))
  362.           until (I^ in [CR,LF]) or (k >= InputBufSize);
  363.           while (I^ in [CR,LF]) and (k < InputBufSize) do
  364.           begin
  365.             Inc(I);
  366.             Inc(k)
  367.           end
  368.         end
  369.       until k >= InputBufSize;
  370.       if Assigned(FOnProgress) then
  371.         FOnProgress(trunc((100.0 * Size) / OutputBufSize))
  372.     end {Decode};
  373.  
  374.  
  375.   begin { UUCode }
  376.     if FInputFileName = '' then
  377.       raise EUUCode.Create(EUUInputEmpty);
  378.     if (FAlgorithm in [uuencode,xxencode,base64encode,filecopy]) and
  379.        (FOutputFileName = '') then
  380.       raise EUUCode.Create(EUUOutputEmpty);
  381.     InputBufSize := FileSize(FInputFileName); {!!}
  382.     GetMem(InputBuffer,InputBufSize + SizeOf(TTripLet)); {!!}
  383.     FillChar(InputBuffer^,InputBufSize + SizeOf(TTripLet),#0); {!!}
  384.     try
  385.       OutputBufSize := InputBufSize + SizeOf(TTripLet); {!!}
  386.       if FAlgorithm in [uuencode,xxencode,base64encode] then
  387.         OutputBufSize := OutputBufSize + (OutputBufSize div 3)
  388.                                        + (OutputBufSize div 15) { length, CR, LF }
  389.                                        + 32;
  390.       if FAlgorithm <> filecopy then
  391.       begin
  392.         GetMem(OutputBuffer,OutputBufSize);
  393.         FillChar(OutputBuffer^,OutputBufSize,#0)
  394.       end;
  395.       try
  396.         System.Assign(f,FInputFileName);
  397.         Reset(f,1);
  398.         BlockRead(f,InputBuffer^,InputBufSize,Size);
  399.         System.Close(f);
  400.         case FAlgorithm of
  401.           uuencode: Encode(False,False);
  402.           xxencode: Encode(False,True);
  403.       base64encode: Encode(True,False);
  404.           uudecode: Decode(False,False);
  405.           xxdecode: Decode(False,True);
  406.       base64decode: Decode(True,False);
  407.           filecopy: OutputBuffer := InputBuffer
  408.         end;
  409.         System.Assign(f,FOutputFileName);
  410.         Rewrite(f,1);
  411.         BlockWrite(f,OutputBuffer^,Size);
  412.         System.Close(f);
  413.         if Assigned(FOnProgress) then
  414.           FOnProgress(100) { ready }
  415.       finally
  416.         if FAlgorithm <> filecopy then
  417.           FreeMem(OutputBuffer, OutputBufSize)
  418.       end
  419.     finally
  420.       FreeMem(InputBuffer, InputBufSize + SizeOf(TTripLet)) {!!}
  421.     end
  422.   end {UUCode};
  423. end.
  424.